home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1999 April / macformat-075.iso / Shareware Plus / Applications / Alpha / Tcl / SystemCode / CorePackages / aeparse.tcl < prev    next >
Encoding:
Text File  |  1998-11-21  |  18.8 KB  |  540 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*- (nowrap)
  2.  # ###################################################################
  3.  #  AEParse - Parsing functions for AEGizmo strings
  4.  # 
  5.  #  FILE: "aeparse.tcl" (formerly aevt.tcl)
  6.  #                                    created: 7/26/97 {6:44:05 pm} 
  7.  #                                last update: 11/21/98 {10:21:12 PM} 
  8.  #                                    version: 1.1
  9.  #  Author: Jonathan Guyer
  10.  #  E-mail: <jguyer@his.com>
  11.  #     www: <http://www.his.com/~jguyer/>
  12.  #  
  13.  # ###################################################################
  14.  ##
  15.  
  16. ## 
  17.  # Copyright (c) 1998  Jonathan    Guyer
  18.  # 
  19.  # This    program    is free    software; you can redistribute it and/or modify
  20.  # it under    the    terms of the GNU General Public    License    as published by
  21.  # the Free    Software Foundation; either    version    2 of the License, or
  22.  # (at your    option)    any    later version.
  23.  # 
  24.  # This    program    is distributed in the hope that    it will    be useful,
  25.  # but WITHOUT ANY WARRANTY; without even the implied warranty of
  26.  # MERCHANTABILITY or FITNESS FOR A    PARTICULAR PURPOSE.     See the
  27.  # GNU General Public License for more details.
  28.  # 
  29.  # You should have received    a copy of the GNU General Public License
  30.  # along with this program;    if not,    write to the Free Software
  31.  # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,    USA.
  32.  ##
  33.  
  34. ## 
  35.  # Note that 'try' is used very sparingly in this code because, 
  36.  # although syntactically pleasing, it is too slow.
  37.  ##
  38.  
  39. ## 
  40.  # With the exception of aeparse::event, the parsers in this package 
  41.  # take the _name_ of a string variable as their argument and the 
  42.  # string is parsed in place.  Because it will typically be used to 
  43.  # parse the output of ‘AEBuild -r’, aeparse::event takes a string 
  44.  # as its argument.  Since there is no forseeable reason for 
  45.  # external code to call any parser but aeparse::event, this 
  46.  # distinction should not be a problem.
  47.  ##
  48.  
  49. namespace eval aeparse {}
  50.  
  51. # ◊◊◊◊ Initialization Code ◊◊◊◊ #
  52.  
  53. # Error messages from
  54. # <http://devworld.apple.com/dev/techsupport/insidemac/
  55. # AppleScriptLang/AppleScriptLang-271.html#HEADING271-0>
  56.  
  57. # Many, obviously, aren't relevant
  58.     
  59. # Operating System Errors
  60.  
  61. set aeparse::errors(-34)    {System -34 {Disk is full.}}
  62. set aeparse::errors(-35)    {System -35 {Disk wasn't found.}}
  63. set aeparse::errors(-37)    {System -37 {Bad name for file.}}
  64. set aeparse::errors(-38)    {System -38 {File wasn't open.}}
  65. set aeparse::errors(-39)    {System -39 {End of file error.}}
  66. set aeparse::errors(-42)    {System -42 {Too many files open.}}
  67. set aeparse::errors(-43)    {System -43 {File wasn't found.}}
  68. set aeparse::errors(-44)    {System -44 {Disk is write protected.}}
  69. set aeparse::errors(-45)    {System -45 {File is locked.}}
  70. set aeparse::errors(-46)    {System -46 {Disk is locked.}}
  71. set aeparse::errors(-47)    {System -47 {File is busy.}}
  72. set aeparse::errors(-48)    {System -48 {Duplicate file name.}}
  73. set aeparse::errors(-49)    {System -49 {File is already open.}}
  74. set aeparse::errors(-50)    {System -50 {Parameter error.}}
  75. set aeparse::errors(-51)    {System -51 {File reference number error.}}
  76. set aeparse::errors(-61)    {System -61 {File not open with write permission.}}
  77. set aeparse::errors(-108)    {System -108 {Out of memory.}}
  78. set aeparse::errors(-120)    {System -120 {Folder wasn't found.}}
  79. set aeparse::errors(-124)    {System -124 {Disk is disconnected.}}
  80. set aeparse::errors(-128)    {System -128 {User canceled.}}
  81. set aeparse::errors(-192)    {System -192 {A resource wasn't found.}}
  82. set aeparse::errors(-600)    {System -600 {Application isn't running.}}
  83. set aeparse::errors(-601)    {System -601 {Not enough room to launch application with special requirements.}}
  84. set aeparse::errors(-602)    {System -602 {Application is not 32-bit clean.}}         
  85. set aeparse::errors(-605)    {System -605 {More memory is needed than is specified in the size resource.}}
  86. set aeparse::errors(-606)    {System -606 {Application is background-only.}}
  87. set aeparse::errors(-607)    {System -607 {Buffer is too small.}}
  88. set aeparse::errors(-608)    {System -608 {No outstanding high-level event.}}
  89. set aeparse::errors(-609)    {System -609 {Connection is invalid.}}
  90. set aeparse::errors(-904)    {System -904 {Not enough system memory to connect to remote application.}}
  91. set aeparse::errors(-905)    {System -905 {Remote access is not allowed.}}
  92. set aeparse::errors(-906)    {System -906 {Program isn't running or program linking isn't enabled.}}
  93. set aeparse::errors(-915)    {System -915 {Can't find remote machine.}}
  94. set aeparse::errors(-30720)    {System -30720 {Invalid date and time.}}
  95.     
  96. # AppleEvent Errors
  97.     
  98. set aeparse::errors(-1700)    {AppleEvent -1700 {Can't make some data into the expected type.}}
  99. set aeparse::errors(-1701)    {AppleEvent -1701 {Some parameter is missing.}}
  100. set aeparse::errors(-1702)    {AppleEvent -1702 {Some data could not be read.}}
  101. set aeparse::errors(-1703)    {AppleEvent -1703 {Some data was the wrong type.}}
  102. set aeparse::errors(-1704)    {AppleEvent -1704 {Some parameter was invalid.}}
  103. set aeparse::errors(-1705)    {AppleEvent -1705 {Operation involving a list item failed.}}
  104. set aeparse::errors(-1706)    {AppleEvent -1706 {Need a newer version of the AppleEvent manager.}}
  105. set aeparse::errors(-1707)    {AppleEvent -1707 {Event isn't an AppleEvent.}}
  106. set aeparse::errors(-1708)    {AppleEvent -1708 {<reference> doesn't understand the <commandName> message.}}
  107. set aeparse::errors(-1709)    {AppleEvent -1709 {AEResetTimer was passed an invalid reply.}}
  108. set aeparse::errors(-1710)    {AppleEvent -1710 {Invalid sending mode was passed.}}
  109. set aeparse::errors(-1711)    {AppleEvent -1711 {User canceled out of wait loop for reply or receipt.}}
  110. set aeparse::errors(-1712)    {AppleEvent -1712 {AppleEvent timed out.}}
  111. set aeparse::errors(-1713)    {AppleEvent -1713 {No user interaction allowed.}}
  112. set aeparse::errors(-1714)    {AppleEvent -1714 {Wrong keyword for a special function.}}
  113. set aeparse::errors(-1715)    {AppleEvent -1715 {Some parameter wasn't understood.}}
  114. set aeparse::errors(-1716)    {AppleEvent -1716 {Unknown AppleEvent address type.}}
  115. set aeparse::errors(-1717)    {AppleEvent -1717 {The handler is not defined.}}
  116. set aeparse::errors(-1718)    {AppleEvent -1718 {Reply has not yet arrived.}}
  117. set aeparse::errors(-1719)    {AppleEvent -1719 {Can't get <reference>. Invalid index.}}
  118. set aeparse::errors(-1720)    {AppleEvent -1720 {Invalid range.}}
  119. set aeparse::errors(-1721)    {AppleEvent -1721 {<expression> doesn't match the parameters <parameterNames> for <commandName>.}}
  120. set aeparse::errors(-1723)    {AppleEvent -1723 {Can't get <expression>. Access not allowed.}}
  121. set aeparse::errors(-1725)    {AppleEvent -1725 {Illegal logical operator called.}}
  122. set aeparse::errors(-1726)    {AppleEvent -1726 {Illegal comparison or logical.}}
  123. set aeparse::errors(-1727)    {AppleEvent -1727 {Expected a reference.}}
  124. set aeparse::errors(-1728)    {AppleEvent -1728 {Can't get <reference>.}}
  125. set aeparse::errors(-1729)    {AppleEvent -1729 {Object counting procedure returned a negative count.}}
  126. set aeparse::errors(-1730)    {AppleEvent -1730 {Container specified was an empty list.}}
  127. set aeparse::errors(-1731)    {AppleEvent -1731 {Unknown object type.}}
  128. set aeparse::errors(-1750)    {AppleEvent -1750 {Scripting component error.}}
  129. set aeparse::errors(-1751)    {AppleEvent -1751 {Invalid script id.}}
  130. set aeparse::errors(-1752)    {AppleEvent -1752 {Script doesn't seem to belong to AppleScript.}}
  131. set aeparse::errors(-1753)    {AppleEvent -1753 {Script error.}}
  132. set aeparse::errors(-1754)    {AppleEvent -1754 {Invalid selector given.}}
  133. set aeparse::errors(-1755)    {AppleEvent -1755 {Invalid access.}}
  134. set aeparse::errors(-1756)    {AppleEvent -1756 {Source not available.}}
  135. set aeparse::errors(-1757)    {AppleEvent -1757 {No such dialect.}}
  136. set aeparse::errors(-1758)    {AppleEvent -1758 {Data couldn't be read because its format is obsolete.}}
  137. set aeparse::errors(-1759)    {AppleEvent -1759 {Data couldn't be read because its format is too new.}}
  138. set aeparse::errors(-1760)    {AppleEvent -1760 {Recording is already on.}}
  139.  
  140. # AppleEvent Registry Errors
  141.  
  142. set aeparse::errors(-10000)    {AERegistry -10000 {AppleEvent handler failed.}}
  143. set aeparse::errors(-10001)    {AERegistry -10001 {A descriptor type mismatch occurred.}}
  144. set aeparse::errors(-10002)    {AERegistry -10002 {Invalid key form.}}
  145. set aeparse::errors(-10003)    {AERegistry -10003 {Can't set <object or data> to <object or data>. Access not allowed.}}
  146. set aeparse::errors(-10004)    {AERegistry -10004 {A privilege violation occurred.}}
  147. set aeparse::errors(-10005)    {AERegistry -10005 {The read operation wasn't allowed.}}
  148. set aeparse::errors(-10006)    {AERegistry -10006 {Can't set <object or data> to <object or data>.}}
  149. set aeparse::errors(-10007)    {AERegistry -10007 {The index of the event is too large to be valid.}}
  150. set aeparse::errors(-10008)    {AERegistry -10008 {The specified object is a property, not an element.}}
  151. set aeparse::errors(-10009)    {AERegistry -10009 {Can't supply the requested descriptor type for the data.}}
  152. set aeparse::errors(-10010)    {AERegistry -10010 {The AppleEvent handler can't handle objects of this class.}}
  153. set aeparse::errors(-10011)    {AERegistry -10011 {Couldn't handle this command because it wasn't part of the current transaction.}}
  154. set aeparse::errors(-10012)    {AERegistry -10012 {The transaction to which this command belonged isn't a valid transaction.}}
  155. set aeparse::errors(-10013)    {AERegistry -10013 {There is no user selection.}}
  156. set aeparse::errors(-10014)    {AERegistry -10014 {Handler only handles single objects.}}
  157. set aeparse::errors(-10015)    {AERegistry -10015 {Can't undo the previous AppleEvent or user action.}}
  158.  
  159. # ◊◊◊◊ Grammar Rules ◊◊◊◊ #
  160.  
  161. ## 
  162.  # ident ::= identchar (identchar |    digit)*       —Padded/truncated
  163.  #             ' character* '                       to exactly 4    chars
  164.  ##
  165. proc aeparse::ident {chrs} {
  166.     upvar $chrs chars
  167.     
  168.     set identchar    {[^][(){} \r\t\n0-9'“”«»:,@]}
  169.     if {![regexp "^\\s*(${identchar}(${identchar}|\[0-9\])*)(.*)" $chars blah type blah chars]} {
  170.         if {![regexp "^\\s*'(\[^'\]*)'(.*)" $chars blah type chars]} {
  171.             error "no ident" "" {AEParse "no ident"}
  172.         }
  173.     }
  174.     return [string range [format "%-4s" $type] 0 3]
  175. }
  176.  
  177. ## 
  178.  # event ::= ident '\' ident keywordlist
  179.  # 
  180.  # NOTE:    This is the only parsing routine in this package 
  181.  #             which takes a string as an argument and, thus, can
  182.  #             have the output of ‘AEBuild -r’ piped into it.
  183.  ##
  184. proc aeparse::event {chars args} {
  185.     global aecoerce::overrides aecoerce::noCoerce
  186.     
  187.     set opts(-all) 0
  188.     set opts(-coerce) {}
  189.     set opts(-noCoerce) {}
  190.     
  191.     getOpts {coerce noCoerce}
  192.     
  193.     # this call to aeparse::event is potentially
  194.     # called by a coercion from an outer call.
  195.     # alis -> TEXT is an example.
  196.     catch {set savedOverrides ${aecoerce::overrides}}
  197.     catch {set savedNoCoerce  ${aecoerce::noCoerce}}
  198.     
  199.     set aecoerce::overrides $opts(-coerce)
  200.     set aecoerce::noCoerce  $opts(-noCoerce)
  201.     
  202.     if {[regexp {^([^\\]*)\\(.*)$} $chars blah class chars]} {
  203.     
  204.         # Make sure $class is formatted correctly
  205.         set class [aeparse::ident class]
  206.         set event [aeparse::ident chars]
  207.         
  208.         set parameters [aeparse::structure chars]
  209.         
  210.         aeparse::ERROR $parameters
  211.         
  212.         if {[string length [string trimleft $chars]] != 0} {
  213.             set errorMsg "Unexpected extra stuff past end"
  214.             error $errorMsg "" [list AEParse 3 $errorMsg]
  215.         } 
  216.         
  217.         if {$opts(-all)} {
  218.             return [list $class $event $parameters]
  219.         } else {
  220.             return $parameters
  221.         }
  222.     } else {
  223.         set errorMsg "Unexpected end of format string" 
  224.         error $errorMsg "" [list AEParse 2 $errorMsg]
  225.     }
  226.     
  227.     catch {set aecoerce::overrides $savedOverrides}
  228.     catch {set aecoerce::noCoerce $savedNoCoerce}
  229. }
  230.  
  231. ## 
  232.  # obj ::= data                 —Single AEDesc; shortcut for (data)
  233.  #           structure         —Un-coerced structure
  234.  #           ident structure     —Coerced to some other    type
  235.  ##
  236. proc aeparse::obj {chrs} {
  237.     upvar $chrs chars
  238.     
  239.     global errorCode errorMsg
  240.     
  241.     if {[catch {set result [aeparse::data chars]} errorMsg]} {
  242.         if {$errorMsg == "no data"} {
  243.             set result [aeparse::structure chars]            
  244.         } else {
  245.             error::rethrow
  246.         }
  247.     } else {
  248.         if {[lindex $result 0] == "type"} {
  249.             set type [lindex $result 1]
  250.             if {[catch {set data [aeparse::structure chars]} errorMsg]} {
  251.                 if {$errorMsg == "no structure"} {
  252.                     # had form 'type'('data') so attempt to coerce
  253.                     # 'data' to 'type'.
  254.                     if {[catch {set data [aecoerce::apply $result $type]} errorMsg]} {
  255.                         if {[string match {AECoerce 1700 *} $errorCode]} {
  256.                             # no coercion available
  257.                             set data $type
  258.                             set type "type"
  259.                         } else {
  260.                             error::rethrow
  261.                         }
  262.                     }
  263.                 } else {
  264.                     error::rethrow
  265.                 }
  266.             } else {
  267.                 if {[catch {set data [aecoerce::apply $data $type]} errorMsg]} {
  268.                     if {![string match {AECoerce 1700 *} $errorCode]} {
  269.                         error::rethrow
  270.                     }
  271.                 }
  272.             }
  273.             set result [list $type $data]
  274.         } 
  275.     }
  276.     return $result
  277. }
  278.  
  279. ## 
  280.  # structure ::= ( data    )           —Single AEDesc
  281.  #                 [ objectlist ]       —AEList type
  282.  #                 { keywordlist }   —AERecord type
  283.  ##
  284. proc aeparse::structure {chrs} {
  285.     global errorMsg
  286.     
  287.     upvar $chrs chars
  288.     
  289.     if {[regexp {^\s*\((.*)} $chars blah chars]} {
  290.         if {[catch {set result [aeparse::data chars]} errorMsg]} {
  291.             if {$errorMsg == "no data"} {
  292.                 if {[regexp {^\s*\)(.*)} $chars blah chars]} {
  293.                     set result [list "null" ""]
  294.                 } else {
  295.                     set msg "Missing “)” after data value"
  296.                     error $msg "" [list AEParse 13 $msg]
  297.                 }
  298.             } else {
  299.                 error::rethrow
  300.             }
  301.         } else {
  302.             if {![regexp {^\s*\)(.*)} $chars blah chars]} {
  303.                 set msg "Missing “)” after data value"
  304.                 error $msg "" [list AEParse 13 $msg]
  305.             }
  306.         }
  307.     } elseif {[catch {set result [aeparse::objectlist chars]} errorMsg]} {
  308.         if {$errorMsg == "no list"} {
  309.             if {[catch {set result [aeparse::reco chars]} errorMsg]} {
  310.                 if {$errorMsg == "no reco"} {
  311.                     error "no structure"
  312.                 } else {
  313.                     error::rethrow
  314.                 }
  315.             }
  316.         } else {
  317.             error::rethrow
  318.         }
  319.     }
  320.     
  321.     return $result
  322. }
  323.  
  324. ## 
  325.  #       list ::= [ objectlist ]
  326.  # objectlist ::= «blank»              —Comma-separated list    of things
  327.  #                  obj [    , obj ]*
  328.  #                  
  329.  # NOTE: proc is named 'objectlist' to avoid namespace collision
  330.  # and because the distinction is irrelevant here. 
  331.  # aeparse::objectlist expects to find the [ ] brackets.
  332.  ##
  333. proc aeparse::objectlist {chrs} {
  334.     upvar $chrs chars
  335.     
  336. #     set chars [string trimleft $chars]
  337.     set result ""
  338.     if {[regexp {^\s*\[(.*)} $chars blah chars]} {
  339.         if {![regexp {^\s*\](.*)} $chars blah chars]} {
  340.             while 1 {
  341.                 lappend result [aeparse::obj chars]
  342.                 regexp {^\s*(.)(.*)} $chars blah next chars
  343.                 if {$next == "\]"} {
  344.                     break
  345.                 } elseif {$next != ","} {
  346.                     set msg "Expected “,” or “\]”"
  347.                     error $msg "" [list AEParse 14 $msg]
  348.                 }        
  349.             }
  350.         }
  351.         set result [list "list" $result]
  352.     } else {
  353.         error "no list" "" {AEParse "no list"}
  354.     }
  355.     return $result
  356. }
  357.  
  358. ## 
  359.  # keywordpair ::= ident : obj          —Keyword/value pair
  360.  ##
  361. proc aeparse::keywordpair {chrs} {
  362.     global errorMsg
  363.     
  364.     upvar $chrs chars
  365.     
  366.     if {[catch {set keyword [aeparse::ident chars]} errorMsg]} {
  367.         if {$errorMsg == "no ident"} {
  368.             set msg "Missing keyword in record" 
  369.             error $msg "" [list AEParse 16 $msg]
  370.         } else {
  371.             error::rethrow
  372.         }
  373.     } else {
  374.         if {[regexp {^\s*:(.*)} $chars blah chars]} {
  375.             set value [aeparse::obj chars]
  376.             set result [list $keyword $value]
  377.         } else {
  378.             set msg "Missing “:” after keyword in record"
  379.             error $msg "" [list AEParse 17 $msg]
  380.         }
  381.     }
  382.     
  383.     return $result
  384. }
  385.  
  386. ## 
  387.  #      record ::= { keywordlist }
  388.  # keywordlist ::= «blank»                —List of said pairs
  389.  #                   keywordpair [ , keywordpair ]*
  390.  ##
  391. proc aeparse::reco {chrs} {
  392.     upvar $chrs chars
  393.     
  394.     set result ""
  395.     if {[regexp {^\s*\{(.*)} $chars blah chars]} {
  396.         if {![regexp {^\s*\}(.*)} $chars blah chars]} {
  397.             while 1 {
  398.                 lappend result [aeparse::keywordpair chars]
  399.                 regexp {^\s*(.)(.*)} $chars blah next chars
  400.                 if {$next == "\}"} {
  401.                     break
  402.                 } elseif {$next != ","} {
  403.                     set msg "Expected “,” or “\}”"
  404.                     error $msg "" [list AEParse 15 $msg]
  405.                 }
  406.             }
  407.         }
  408.         set result [list "reco" $result]
  409.     } else {
  410.         error "no reco" "" {AEParse "no reco"}
  411.     }
  412.     return $result
  413. }
  414.  
  415. ## 
  416.  # integer ::=    [ - ] digit+    —Just as in C
  417.  # string ::=    “ (character)* ”
  418.  # hexstring ::=    « (hexdigit | whitespace)* »    —Even no. of digits, please
  419.  # data    ::=    @           —Gets appropriate data from fn param
  420.  #            integer       —'shor' or 'long' unless    coerced
  421.  #            ident       —A 4-char type code ('type')    unless coerced
  422.  #            string       —Unterminated text; 'TEXT' type unless coerced
  423.  #            hexstring  —Raw    hex    data; must be coerced to some type!
  424.  ##
  425. proc aeparse::data {chrs} {
  426.     global errorMsg
  427.     
  428.     upvar $chrs chars
  429.     
  430.     if {[regexp {^\s*@(.*)} $chars blah chars]} {
  431.         set result [list "@" "@"] 
  432.     } elseif {[regexp {^\s*(-?[0-9]+)(.*)$} $chars blah long chars]} {
  433.         # long or short is arbitrary for Alpha
  434.         set result [list "long" $long]
  435.     } elseif {[regexp {^\s*“([^”]*)”(.*)} $chars blah TEXT chars]} {
  436.         set result [list "TEXT" $TEXT]
  437.     } elseif {[regexp {^\s*«([0-9a-fA-F \r\t\n]*)»(.*)$} $chars blah hexd chars]} {
  438.         set result [list "hexd" $hexd]
  439.     } elseif {[catch {set result [list "type" [aeparse::ident chars]]} errorMsg]} {
  440.         if {$errorMsg == "no ident"} {
  441.             error "no data" "" {AEParse "no data"}
  442.         } else {
  443.             error::rethrow
  444.         }
  445.     }
  446.     return $result
  447. }
  448.  
  449. # ◊◊◊◊ Utilities ◊◊◊◊ #
  450.  
  451. ## 
  452.  # -------------------------------------------------------------------------
  453.  # 
  454.  # "aeparse::ERROR" --
  455.  # 
  456.  #  Look for error keys in 'event' and, if they exist, throw them 
  457.  # -------------------------------------------------------------------------
  458.  ##
  459. proc aeparse::ERROR {event} {
  460.     global aeparse::errors errorCode
  461.     
  462.     set errn 0
  463.     set errs ""
  464.     
  465.     # No error for missing keywords. Rethrow everything else.
  466.     
  467.     if {[catch {set errn [aeparse::keywordValue "errn" $event]}]} {
  468.         if {![string match {AEParse 16 *} $errorCode]} {
  469.             error::rethrow
  470.         }
  471.     }
  472.       
  473.     if {[catch {set errs [aeparse::keywordValue "errs" $event]}]} {
  474.         if {![string match {AEParse 16 *} $errorCode]} {
  475.             error::rethrow
  476.         }
  477.     }
  478.     
  479.     if {[info exists aeparse::errors($errn)]} {
  480.         if {[string length $errs] == 0} {
  481.             set errs [lindex [set aeparse::errors($errn)] 2]
  482.         } 
  483.         set errn [set aeparse::errors($errn)] 
  484.     } 
  485.     
  486.     if {(([string length $errn] != 0) && ($errn != 0))
  487.     ||    ([string length $errs] != 0)} {
  488.         error $errs "" $errn
  489.     }
  490. }
  491.  
  492. ## 
  493.  # -------------------------------------------------------------------------
  494.  # 
  495.  # "aeparse::keywordValue" --
  496.  # 
  497.  # Return the value associated with $keyword in the parsed list 
  498.  # $keywordpairs
  499.  # -------------------------------------------------------------------------
  500.  ##
  501. proc aeparse::keywordValue {keyword record {typed 0}} {
  502.     set keywordpairs [lindex $record 1]
  503.     
  504.     # Strip user supplied '' quotes, if any
  505.     regexp "^'(.*)'$" $keyword blah keyword
  506.     set keyword [format "%-4s" [string range $keyword 0 3]]
  507.     
  508.     # ??? Need to protect any special characters in $keyword
  509.     if {[set i [lsearch -glob $keywordpairs [list $keyword *]]] >= 0} {
  510.         set keywordpair [lindex $keywordpairs $i]
  511.         if {$typed} {
  512.             return [lindex $keywordpair 1]
  513.         } else {
  514.             return [aeparse::stripType [lindex $keywordpair 1]]
  515.         }
  516.     } 
  517.     set msg "Missing keyword '${keyword}' in record"
  518.     error $msg "" [list AEParse 16 $msg]
  519. }
  520.  
  521. proc aeparse::stripType {typeValue} {
  522.     set result ""
  523.     
  524.     switch [lindex $typeValue 0] {
  525.         "list" {
  526.             foreach item [lindex $typeValue 1] {
  527.                 lappend result [aeparse::stripType $item]
  528.             }
  529.         }
  530.         "reco" {
  531.             # leave it alone, so that aeparse::keywordValue
  532.             # can be used on it.
  533.         }
  534.         default {
  535.             set result [lindex $typeValue 1]
  536.         }
  537.     }
  538.     return $result
  539. }
  540.